home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / share / multimed / myflix_win32 / myflix_win32.exe / data1.cab / Libraries / tcl8.0 / ldAout.tcl < prev    next >
Text File  |  1998-03-10  |  7KB  |  241 lines
  1. # ldAout.tcl --
  2. #
  3. #    This "tclldAout" procedure in this script acts as a replacement
  4. #    for the "ld" command when linking an object file that will be
  5. #    loaded dynamically into Tcl or Tk using pseudo-static linking.
  6. #
  7. # Parameters:
  8. #    The arguments to the script are the command line options for
  9. #    an "ld" command.
  10. #
  11. # Results:
  12. #    The "ld" command is parsed, and the "-o" option determines the
  13. #    module name.  ".a" and ".o" options are accumulated.
  14. #    The input archives and object files are examined with the "nm"
  15. #    command to determine whether the modules initialization
  16. #    entry and safe initialization entry are present.  A trivial
  17. #    C function that locates the entries is composed, compiled, and
  18. #    its .o file placed before all others in the command; then
  19. #    "ld" is executed to bind the objects together.
  20. #
  21. # SCCS: @(#) ldAout.tcl 1.12 96/11/30 17:11:02
  22. #
  23. # Copyright (c) 1995, by General Electric Company. All rights reserved.
  24. #
  25. # See the file "license.terms" for information on usage and redistribution
  26. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  27. #
  28. # This work was supported in part by the ARPA Manufacturing Automation
  29. # and Design Engineering (MADE) Initiative through ARPA contract
  30. # F33615-94-C-4400.
  31.  
  32. proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
  33.   global env
  34.   global argv
  35.  
  36.   if {$cc==""} {
  37.     set cc $env(CC)
  38.   }
  39.  
  40.   # if only two parameters are supplied there is assumed that the
  41.   # only shlib_suffix is missing. This parameter is anyway available
  42.   # as "info sharedlibextension" too, so there is no need to transfer
  43.   # 3 parameters to the function tclLdAout. For compatibility, this
  44.   # function now accepts both 2 and 3 parameters.
  45.  
  46.   if {$shlib_suffix==""} {
  47.     set shlib_cflags $env(SHLIB_CFLAGS)
  48.   } else {
  49.     if {$shlib_cflags=="none"} {
  50.       set shlib_cflags $shlib_suffix
  51.     }
  52.   }
  53.  
  54.   # seenDotO is nonzero if a .o or .a file has been seen
  55.  
  56.   set seenDotO 0
  57.  
  58.   # minusO is nonzero if the last command line argument was "-o".
  59.  
  60.   set minusO 0
  61.  
  62.   # head has command line arguments up to but not including the first
  63.   # .o or .a file. tail has the rest of the arguments.
  64.  
  65.   set head {}
  66.   set tail {}
  67.  
  68.   # nmCommand is the "nm" command that lists global symbols from the
  69.   # object files.
  70.  
  71.   set nmCommand {|nm -g}
  72.  
  73.   # entryProtos is the table of _Init and _SafeInit prototypes found in the
  74.   # module.
  75.  
  76.   set entryProtos {}
  77.  
  78.   # entryPoints is the table of _Init and _SafeInit entries found in the
  79.   # module.
  80.  
  81.   set entryPoints {}
  82.  
  83.   # libraries is the list of -L and -l flags to the linker.
  84.  
  85.   set libraries {}
  86.   set libdirs {}
  87.  
  88.   # Process command line arguments
  89.  
  90.   foreach a $argv {
  91.     if {!$minusO && [regexp {\.[ao]$} $a]} {
  92.       set seenDotO 1
  93.       lappend nmCommand $a
  94.     }
  95.     if {$minusO} {
  96.       set outputFile $a
  97.       set minusO 0
  98.     } elseif {![string compare $a -o]} {
  99.       set minusO 1
  100.     }
  101.     if [regexp {^-[lL]} $a] {
  102.     lappend libraries $a
  103.     if [regexp {^-L} $a] {
  104.         lappend libdirs [string range $a 2 end]
  105.     }
  106.     } elseif {$seenDotO} {
  107.     lappend tail $a
  108.     } else {
  109.     lappend head $a
  110.     }
  111.   }
  112.   lappend libdirs /lib /usr/lib
  113.  
  114.   # MIPS -- If there are corresponding G0 libraries, replace the
  115.   # ordinary ones with the G0 ones.
  116.  
  117.   set libs {}
  118.   foreach lib $libraries {
  119.       if [regexp {^-l} $lib] {
  120.       set lname [string range $lib 2 end]
  121.       foreach dir $libdirs {
  122.           if [file exists [file join $dir lib${lname}_G0.a]] {
  123.           set lname ${lname}_G0
  124.           break
  125.           }
  126.       }
  127.       lappend libs -l$lname
  128.       } else {
  129.       lappend libs $lib
  130.       }
  131.   }
  132.   set libraries $libs
  133.  
  134.   # Extract the module name from the "-o" option
  135.  
  136.   if {![info exists outputFile]} {
  137.     error "-o option must be supplied to link a Tcl load module"
  138.   }
  139.   set m [file tail $outputFile]
  140.   if [regexp {\.a$} $outputFile] {
  141.     set shlib_suffix .a
  142.   } else {
  143.     set shlib_suffix ""
  144.   }
  145.   if [regexp {\..*$} $outputFile match] {
  146.     set l [expr [string length $m] - [string length $match]]
  147.   } else {
  148.     error "Output file does not appear to have a suffix"
  149.   }
  150.   set modName [string tolower [string range $m 0 [expr $l-1]]]
  151.   if [regexp {^lib} $modName] {
  152.     set modName [string range $modName 3 end]
  153.   }
  154.   if [regexp {[0-9\.]*(_g0)?$} $modName match] {
  155.     set modName [string range $modName 0 [expr [string length $modName]-[string length $match]-1]]
  156.   }
  157.   set modName "[string toupper [string index $modName 0]][string range $modName 1 end]"
  158.   
  159.   # Catalog initialization entry points found in the module
  160.  
  161.   set f [open $nmCommand r]
  162.   while {[gets $f l] >= 0} {
  163.     if [regexp {T[     ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol] {
  164.       if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {
  165.     set s $symbol
  166.       }
  167.       append entryProtos {extern int } $symbol { (); } \n
  168.       append entryPoints {  } \{ { "} $s {", } $symbol { } \} , \n
  169.     }
  170.   }
  171.   close $f
  172.  
  173.   if {$entryPoints==""} {
  174.     error "No entry point found in objects"
  175.   }
  176.  
  177.   # Compose a C function that resolves the initialization entry points and
  178.   # embeds the required libraries in the object code.
  179.  
  180.   set C {#include <string.h>}
  181.   append C \n
  182.   append C {char TclLoadLibraries_} $modName { [] =} \n
  183.   append C {  "@LIBS: } $libraries {";} \n
  184.   append C $entryProtos
  185.   append C {static struct } \{ \n
  186.   append C {  char * name;} \n
  187.   append C {  int (*value)();} \n
  188.   append C \} {dictionary [] = } \{ \n
  189.   append C $entryPoints
  190.   append C {  0, 0 } \n \} \; \n
  191.   append C {typedef struct Tcl_Interp Tcl_Interp;} \n
  192.   append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
  193.   append C {Tcl_PackageInitProc *} \n
  194.   append C TclLoadDictionary_ $modName { (symbol)} \n
  195.   append C {    char * symbol;} \n
  196.   append C {{
  197.     int i;
  198.     for (i = 0; dictionary [i] . name != 0; ++i) {
  199.       if (!strcmp (symbol, dictionary [i] . name)) {
  200.     return dictionary [i].value;
  201.       }
  202.     }
  203.     return 0;
  204. }} \n
  205.  
  206.   # Write the C module and compile it
  207.  
  208.   set cFile tcl$modName.c
  209.   set f [open $cFile w]
  210.   puts -nonewline $f $C
  211.   close $f
  212.   set ccCommand "$cc -c $shlib_cflags $cFile"
  213.   puts stderr $ccCommand
  214.   eval exec $ccCommand
  215.  
  216.   # Now compose and execute the ld command that packages the module
  217.  
  218.   if {$shlib_suffix == ".a"} {
  219.     set ldCommand "ar cr $outputFile"
  220.     regsub { -o} $tail {} tail
  221.   } else {
  222.   set ldCommand ld
  223.   foreach item $head {
  224.     lappend ldCommand $item
  225.   }
  226.   }
  227.   lappend ldCommand tcl$modName.o
  228.   foreach item $tail {
  229.     lappend ldCommand $item
  230.   }
  231.   puts stderr $ldCommand
  232.   eval exec $ldCommand
  233.   if {$shlib_suffix == ".a"} {
  234.     exec ranlib $outputFile
  235.   }
  236.  
  237.   # Clean up working files
  238.  
  239.   exec /bin/rm $cFile [file rootname $cFile].o
  240. }
  241.